﻿


Imports AutoCAD

Public Class Form1
    Public Property AcApp() As AcadApplication
    Public Property LtAcadHwnd() As IntPtr
    Public Property NewStartApp() As Boolean

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Me.BtnCloseCAD.Enabled = False
        CallAutoCAD()
    End Sub

    Private Sub CallAutoCAD()
        Dim acHelper As New ClsComObjectHelper, err As String = "", comobjs(0 To 0) As Object
        Dim acadPros = acHelper.获取AutoCAD的com对象(comobjs, err)
        Try
            If err = "" Then
                Me.AcApp = comobjs(0)
            Else
                Me.AcApp = New AcadApplication With {.Visible = True}
                Me.NewStartApp = True
            End If
        Catch ex As Exception
            MessageBox.Show(ex.Message)
        Finally
            If Me.AcApp IsNot Nothing Then

                If Me.NewStartApp Then
                    Me.Text = "正在控制新开启的实例: " & Me.AcApp.FullName
                Else
                    Me.BtnCloseCAD.Enabled = True
                    Me.Text = "正在控制已存在的实例: " & Me.AcApp.FullName
                End If

            Else
                Me.Close()
            End If
        End Try
    End Sub

    Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
        If Me.NewStartApp Then
            Me.AcApp.Quit()
            Marshal.FinalReleaseComObject(Me.AcApp)
        End If
    End Sub

    Private Sub BtnCloseCAD_Click(sender As Object, e As EventArgs) Handles BtnCloseCAD.Click
        'If Me.NewStartApp Then
        Me.AcApp.Quit()
        Marshal.FinalReleaseComObject(Me.AcApp)
        'End If
    End Sub

    Private Sub BtnTest_Click(sender As Object, e As EventArgs) Handles BtnTest.Click
        Dim lt As New ClsAcadCmdStrEx, err As String, process(0 To 0) As 进程信息
        process = lt.获取进程信息("acadlt", errstr:=err)
        If err <> "" Then MessageBox.Show(err) : Return
        Me.LtAcadHwnd = New IntPtr(CInt(process.First().窗口句柄))
        AppActivate(Me.AcApp.Caption)
        Dim ent As Object, pt(0 To 2) As Double
        Try
            Me.AcApp.ActiveDocument.Utility.GetEntity(ent, pt, "请选择一个图元:" + Environment.NewLine)
            Dim acadtype = TypeName(ent)
            Select Case acadtype
                Case "IAcadCircle"
                    Dim cir As New ClsCircle
                    cir.CreateFromAcadObject(ent)
                    lt.根据窗口句柄发送绘图命令到cad(process.First().窗口句柄, lt.创建画圆命令(cir, 25))
                Case "IAcadLine"
                    Dim l As New ClsLine2d
                    l.CreateFromAcadObject(ent)
                    lt.根据窗口句柄发送绘图命令到cad(process.First().窗口句柄, lt.创建画直线命令(l, 18))

                Case "IAcadArc"
                    Dim cir As New ClsArc
                    cir.CreateFromAcadObject(ent)
                    lt.根据窗口句柄发送绘图命令到cad(process.First().窗口句柄, lt.创建圆弧命令(cir, 33))

                Case "IAcadLWPolyline"
                    Dim cir As New ClsLwPolyLine
                    cir.CreateFromAcadObject(ent)
                    Dim cmds = lt.创建多边形命令(cir, 40)
                    lt.根据窗口句柄发送绘图命令到cad(process.First().窗口句柄, cmds)
                Case Else
                    MessageBox.Show("暂不支持类型:" & acadtype)
            End Select
        Catch ex As Exception
            MessageBox.Show(ex.Message)
        End Try

    End Sub

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

        Dim clsApp As New ClsAcadApplication
        clsApp.GetInforFromAcad(Me.AcApp)

        Dim acDoc = clsApp.ActiveDocument

        Dim str As New List(Of String)
        Dim blks = acDoc.GetBlocksCollection()
        For Each blk As ClsAcadBlock In blks
            For Each item As ClsAcadEntity In blk.Items
                str.Add(item.ClassName & item.ObjectName)
            Next
        Next
        Me.RichTextBox3.Text = String.Join(Environment.NewLine, str)
    End Sub

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        Dim ori As New ClsPoint3d, p As New ClsPoint3d

        ori.CreatorByXyz(0, 0, 0)


        p.CreatorByXyz(100, 100, 0)


        Me.RichTextBox1.Text = p.StringStyle



        Dim planeNormal As New ClsVector3d

        Dim matrix As New ClsMatrix4Ex

        Dim arr = matrix.CreateScalingMatrixWithBasePoint(10, 10, 10, ori)



        Dim arr5 As New Matrix4(arr)

        Me.RichTextBox2.Text = arr5.ToString()

        Me.RichTextBox3.Text = p.TransformBy(arr).StringStyle


    End Sub
End Class
